-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Dependencies.GUI.Types
-- Copyright   :  (c) 2009--2010 TU Dortmund
-- License     :  BSD3
--
-- Maintainer  :  menge@udo.cs.uni-dortmund.de
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Helper module to build up the GUI initially. 
-- 
--
-----------------------------------------------------------------------------

module Language.Dependencies.GUI.Build where

--local
import Language.Dependencies.GUI.Types
import Language.Dependencies.GUI.Actions 
import Language.Dependencies.References
import Language.Dependencies.Language

-- base
import Control.Monad.Trans (liftIO)
import Control.Monad (when)
import Data.IORef
import Data.Tree

-- filepath
import System.FilePath ((</>))
import System.Directory (getCurrentDirectory)

-- gtk
import Graphics.UI.Gtk hiding (Language) 
import Graphics.UI.Gtk.Gdk.EventM

-- glib
import System.Glib.Signals (ConnectId)

-- glade
import Graphics.UI.Gtk.Glade     

-- gtksourceview
import Graphics.UI.Gtk.SourceView

-- generated on-the-fly by cabal
import Paths_depedit (getDataFileName) 

-- | initiates aststate
buildAststate :: Options -> [Language] -> IO (IORef AstState)
buildAststate opt langs = do
  -- GTK init
  initGUI 

  -- load GladeXML
  Just xml <- xmlNew =<< getDataFileName ("data" </> "depedit.glade")
 
  -- get or create widgets
  window   <- xmlGetWidget xml castToWindow "mainWindow"
  treeviewL <- xmlGetWidget xml castToTreeView "treeviewLeft"
  treeviewR <- xmlGetWidget xml castToTreeView "treeviewRight"

  (tbL) <- buildSourceView opt 
    =<< xmlGetWidget xml castToScrolledWindow "swSourceLeft" 

  (tbR) <- buildSourceView opt 
    =<< xmlGetWidget xml castToScrolledWindow "swSourceRight" 

  lblL <- xmlGetWidget xml castToLabel "lblL"
  lblR <- xmlGetWidget xml castToLabel "lblR"
  
  dlgAbout <-xmlGetWidget xml castToAboutDialog "dlgAbout"  
    
  -- setup configuration tree view
  swConfig <- xmlGetWidget xml castToScrolledWindow "swConfig"
  
  tv <- treeViewNew
  store <- setupConfigTv tv
  
  scrolledWindowAddWithViewport swConfig tv
  
  -- setup paned widgets
  vpnLeft <- xmlGetWidget xml castToPaned "vpnLeft"
  panedSetPosition vpnLeft 400
  
  vpnRight <- xmlGetWidget xml castToPaned "vpnRight"
  panedSetPosition vpnRight 400  
  
  
  -- build compound datatype
  let gui = GUI window 
                (treeviewL,treeviewR) 
                (tbL,tbR) 
                store 
                tv
                dlgAbout 
                (lblL,lblR)
      state = State 
        { cFile = (unsavedDoc,unsavedDoc)
        , textchanged = (False,False)
        , configChanged = False
        , cpath = (GtkPath [0],GtkPath [0])
        , languages = langs
        , configFile = unsavedDoc
        }
        
  r <- newIORef $ AstState state gui opt

  hooks vpnLeft vpnRight r

  menuRelations <- xmlGetWidget xml castToMenu "menuRelations"

  buildMenuFunctions menuRelations r


  -- get all menuitems from xml and register guiactions to them
  mapM_ (registerMenuAction xml r) menuActions
  
  return r

-- -------------------------------------------------------------------
-- ** some helper functions
-- -------------------------------------------------------------------


-- |sets up the function selection 
buildMenuFunctions :: Menu -> AstAction () 
buildMenuFunctions menuRelations ref = do
  fs <- getCompareIds ref
  menu <- menuItemNewWithLabel "Function"
  submenu <- menuNew
  menuItemSetSubmenu menu submenu
  mapM_ (setupSingle submenu menu) fs  
  where
    setupSingle submenu menu (CompareId s) = do
      menuItem <- menuItemNewWithLabel s
      menuShellAppend submenu menuItem
      menuShellAppend menuRelations menu
      onActivateLeaf menuItem $ do 
        maybei <- getSelectedIndex ref
        case maybei of
          Nothing -> return ()
          Just i -> do
            store <- getStoreRelation ref
            v <- listStoreGetValue store i
            listStoreSetValue store i (v {comparison = CompareId s })

-- |builds combobox label for a language
buildLabel :: Language -> String
buildLabel l = 
  name l
  ++ " ["
  ++ concatMap (" "++) (exts l)
  ++ "]"

-- | setup the GtkSourceView and add it to the ScrollPane. return the 
-- underlying textbuffer
buildSourceView :: Options -> ScrolledWindow -> IO SourceBuffer
buildSourceView opt sw = do
  sourceBuffer <- sourceBufferNew Nothing
  sourceBufferSetHighlightSyntax sourceBuffer True
  sourceView <- sourceViewNewWithBuffer sourceBuffer
  sourceViewSetShowLineNumbers sourceView True
  sourceViewSetHighlightCurrentLine sourceView True
  srcfont <- fontDescriptionFromString $ 
    font opt ++" "++show (fsize opt)
  widgetModifyFont sourceView (Just srcfont)
  containerAdd sw sourceView 
  return sourceBuffer

-- | registers one GUIAction with a MenuItem
registerMenuAction 
  :: GladeXML -> IORef AstState 
  -> (String,AstAction ()) -> IO (ConnectId MenuItem)
registerMenuAction xml ref (gtkId,action) = do
  item <- xmlGetWidget xml castToMenuItem gtkId
  onActivateLeaf item $ action ref

-- |builds relation listview  
setupConfigTv :: TreeView -> IO (ListStore Relation)
setupConfigTv view = do 
      store <- listStoreNew []
      treeViewSetModel view store
      treeViewSetHeadersVisible view True
      
      col1 <- treeViewColumnNew
      col2 <- treeViewColumnNew
      col3 <- treeViewColumnNew
      col4 <- treeViewColumnNew
      col5 <- treeViewColumnNew

      treeViewColumnSetResizable col1 True 
      treeViewColumnSetResizable col2 True 
      treeViewColumnSetResizable col3 True 
      treeViewColumnSetResizable col4 True 
      treeViewColumnSetResizable col5 True 
      
      renderer1 <- cellRendererTextNew
      renderer2 <- cellRendererTextNew   
      renderer3 <- cellRendererTextNew
      renderer4 <- cellRendererTextNew
      renderer5 <- cellRendererTextNew        
       
      cellLayoutPackStart col1 renderer1 True 
      cellLayoutPackStart col2 renderer2 True
      cellLayoutPackStart col3 renderer3 True 
      cellLayoutPackStart col4 renderer4 True
      cellLayoutPackStart col5 renderer5 True      
      
      cellLayoutSetAttributes col1 renderer1 store $ 
        \row -> [ cellText := show $ dpath  $ e1 row ]
      cellLayoutSetAttributes col2 renderer2 store $ 
        \row -> [ cellText := filepath $ e1 row ]
      cellLayoutSetAttributes col3 renderer3 store $ 
        \row -> [ cellText := show $ dpath $ e2 $ row ]
      cellLayoutSetAttributes col4 renderer4 store $ 
        \row -> [ cellText := filepath $ e2 row ]        
      cellLayoutSetAttributes col5 renderer5 store $ 
        \row -> [ cellText := show $ comparison row ]   
            
      treeViewColumnSetTitle col1 "Pfad1"
      treeViewColumnSetTitle col2 "Datei1"
      treeViewColumnSetTitle col3 "Pfad2"
      treeViewColumnSetTitle col4 "Datei2"
      treeViewColumnSetTitle col5 "Funktion"      

      treeViewColumnSetSizing col1 TreeViewColumnGrowOnly
      treeViewColumnSetSizing col2 TreeViewColumnGrowOnly
      treeViewColumnSetSizing col3 TreeViewColumnGrowOnly
      treeViewColumnSetSizing col4 TreeViewColumnGrowOnly
      treeViewColumnSetSizing col5 TreeViewColumnGrowOnly
            
      treeViewAppendColumn view col1
      treeViewAppendColumn view col2  
      treeViewAppendColumn view col3
      treeViewAppendColumn view col4   
      treeViewAppendColumn view col5       

--       treeViewColumnsAutosize view

      return store


-- | adds actions to some widgets
-- hooks :: AstAction (ConnectId Window)
hooks vpnLeft vpnRight ref = do
  gui <- getGui ref

  -- ctrl+p to reparse
  window gui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "p" <- eventKeyName
    liftIO $ actionReparseAll ref 
  -- ctrl+m to modify selected relation
  window gui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "m" <- eventKeyName
    liftIO $ actionModifyRelation ref     
  -- ctrl+r to add relation
  window gui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "r" <- eventKeyName
    liftIO $ actionAddRelationSrc ref    
  -- double click on a relation in  treeview opens both files
  tvRels gui `on` buttonPressEvent $ tryEvent $ do
    DoubleClick <- eventClick
    LeftButton <- eventButton
    liftIO $ do
      sel <- treeViewGetSelection =<< getTvRelation ref
      numberrows <- treeSelectionCountSelectedRows sel
      when (numberrows > 0) $ do
        i <- fmap (head.head) $ treeSelectionGetSelectedRows sel
        store <- getStoreRelation ref
        (Relation e1 e2 _) <- listStoreGetValue store i
        actionLoadHeadless L (filepath e1) ref 
        actionLoadHeadless R (filepath e2) ref
        tvL <- getTreeView L ref
        tvR <- getTreeView R ref
        actionJumpToGivenPath tvL $ toGtkPath $ dpath e1
        actionJumpToGivenPath tvR $ toGtkPath $ dpath e2
          
  -- ctrl+t to show/hide treeviews
  window gui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "t" <- eventKeyName
    liftIO $ do
      l <- getTreeView L ref
      r <- getTreeView R ref
      let edit widget visible vpn pos = do
            set widget [ widgetVisible := visible ]
            panedSetPosition vpn pos  
          hide = do
            edit l False vpnLeft 10000
            edit r False vpnRight 10000
          unhide = do   
            edit l True vpnLeft 400  
            edit r True vpnRight 400    
      i <- get l widgetVisible                     
      if i then hide else unhide
  dlgAbout gui `onResponse` (const $ widgetHide $ dlgAbout gui)
        
  window gui `on` deleteEvent $ tryEvent $ liftIO $ actionQuit ref
  
  [sb1,sb2] <- getSourceBuffers ref
  onBufferChanged sb1 $ addStar L ref
  onBufferChanged sb2 $ addStar R ref
    
  -- window    
  onDestroy (window gui) mainQuit



  
  
